home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.002 / stk-3 / STk-3.1 / Tk / generic / tkCanvPs.c < prev    next >
Encoding:
C/C++ Source or Header  |  1996-07-23  |  36.1 KB  |  1,159 lines
  1. /* 
  2.  * tkCanvPs.c --
  3.  *
  4.  *    This module provides Postscript output support for canvases,
  5.  *    including the "postscript" widget command plus a few utility
  6.  *    procedures used for generating Postscript.
  7.  *
  8.  * Copyright (c) 1991-1994 The Regents of the University of California.
  9.  * Copyright (c) 1994-1996 Sun Microsystems, Inc.
  10.  *
  11.  * See the file "license.terms" for information on usage and redistribution
  12.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13.  *
  14.  * SCCS: @(#) tkCanvPs.c 1.47 96/04/11 20:23:36
  15.  */
  16.  
  17. #include <stdio.h>
  18. #include "tkInt.h"
  19. #include "tkCanvas.h"
  20. #include "tkPort.h"
  21.  
  22. /*
  23.  * See tkCanvas.h for key data structures used to implement canvases.
  24.  */
  25.  
  26. /*
  27.  * One of the following structures is created to keep track of Postscript
  28.  * output being generated.  It consists mostly of information provided on
  29.  * the widget command line.
  30.  */
  31.  
  32. typedef struct TkPostscriptInfo {
  33.     int x, y, width, height;    /* Area to print, in canvas pixel
  34.                  * coordinates. */
  35.     int x2, y2;            /* x+width and y+height. */
  36.     char *pageXString;        /* String value of "-pagex" option or NULL. */
  37.     char *pageYString;        /* String value of "-pagey" option or NULL. */
  38.     double pageX, pageY;    /* Postscript coordinates (in points)
  39.                  * corresponding to pageXString and
  40.                  * pageYString. Don't forget that y-values
  41.                  * grow upwards for Postscript! */
  42.     char *pageWidthString;    /* Printed width of output. */
  43.     char *pageHeightString;    /* Printed height of output. */
  44.     double scale;        /* Scale factor for conversion: each pixel
  45.                  * maps into this many points. */
  46.     Tk_Anchor pageAnchor;    /* How to anchor bbox on Postscript page. */
  47.     int rotate;            /* Non-zero means output should be rotated
  48.                  * on page (landscape mode). */
  49.     char *fontVar;        /* If non-NULL, gives name of global variable
  50.                  * containing font mapping information.
  51.                  * Malloc'ed. */
  52.     char *colorVar;        /* If non-NULL, give name of global variable
  53.                  * containing color mapping information.
  54.                  * Malloc'ed. */
  55.     char *colorMode;        /* Mode for handling colors:  "monochrome",
  56.                  * "gray", or "color".  Malloc'ed. */
  57.     int colorLevel;        /* Numeric value corresponding to colorMode:
  58.                  * 0 for mono, 1 for gray, 2 for color. */
  59.     char *fileName;        /* Name of file in which to write Postscript;
  60.                  * NULL means return Postscript info as
  61.                  * result. Malloc'ed. */
  62.     FILE *f;            /* Open file corresponding to fileName. */
  63.     Tcl_HashTable fontTable;    /* Hash table containing names of all font
  64.                  * families used in output.  The hash table
  65.                  * values are not used. */
  66.     int prepass;        /* Non-zero means that we're currently in
  67.                  * the pre-pass that collects font information,
  68.                  * so the Postscript generated isn't
  69.                  * relevant. */
  70. } TkPostscriptInfo;
  71.  
  72. /*
  73.  * The table below provides a template that's used to process arguments
  74.  * to the canvas "postscript" command and fill in TkPostscriptInfo
  75.  * structures.
  76.  */
  77.  
  78. static Tk_ConfigSpec configSpecs[] = {
  79.     {TK_CONFIG_STRING, "-colormap", (char *) NULL, (char *) NULL,
  80.     "", Tk_Offset(TkPostscriptInfo, colorVar), 0},
  81.     {TK_CONFIG_STRING, "-colormode", (char *) NULL, (char *) NULL,
  82.     "", Tk_Offset(TkPostscriptInfo, colorMode), 0},
  83.     {TK_CONFIG_STRING, "-file", (char *) NULL, (char *) NULL,
  84.     "", Tk_Offset(TkPostscriptInfo, fileName), 0},
  85.     {TK_CONFIG_STRING, "-fontmap", (char *) NULL, (char *) NULL,
  86.     "", Tk_Offset(TkPostscriptInfo, fontVar), 0},
  87.     {TK_CONFIG_PIXELS, "-height", (char *) NULL, (char *) NULL,
  88.     "", Tk_Offset(TkPostscriptInfo, height), 0},
  89.     {TK_CONFIG_ANCHOR, "-pageanchor", (char *) NULL, (char *) NULL,
  90.     "", Tk_Offset(TkPostscriptInfo, pageAnchor), 0},
  91.     {TK_CONFIG_STRING, "-pageheight", (char *) NULL, (char *) NULL,
  92.     "", Tk_Offset(TkPostscriptInfo, pageHeightString), 0},
  93.     {TK_CONFIG_STRING, "-pagewidth", (char *) NULL, (char *) NULL,
  94.     "", Tk_Offset(TkPostscriptInfo, pageWidthString), 0},
  95.     {TK_CONFIG_STRING, "-pagex", (char *) NULL, (char *) NULL,
  96.     "", Tk_Offset(TkPostscriptInfo, pageXString), 0},
  97.     {TK_CONFIG_STRING, "-pagey", (char *) NULL, (char *) NULL,
  98.     "", Tk_Offset(TkPostscriptInfo, pageYString), 0},
  99.     {TK_CONFIG_BOOLEAN, "-rotate", (char *) NULL, (char *) NULL,
  100.     "", Tk_Offset(TkPostscriptInfo, rotate), 0},
  101.     {TK_CONFIG_PIXELS, "-width", (char *) NULL, (char *) NULL,
  102.     "", Tk_Offset(TkPostscriptInfo, width), 0},
  103.     {TK_CONFIG_PIXELS, "-x", (char *) NULL, (char *) NULL,
  104.     "", Tk_Offset(TkPostscriptInfo, x), 0},
  105.     {TK_CONFIG_PIXELS, "-y", (char *) NULL, (char *) NULL,
  106.     "", Tk_Offset(TkPostscriptInfo, y), 0},
  107.     {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
  108.     (char *) NULL, 0, 0}
  109. };
  110.  
  111. /*
  112.  * Forward declarations for procedures defined later in this file:
  113.  */
  114.  
  115. static int        GetPostscriptPoints _ANSI_ARGS_((Tcl_Interp *interp,
  116.                 char *string, double *doublePtr));
  117.  
  118. /*
  119.  *--------------------------------------------------------------
  120.  *
  121.  * TkCanvPostscriptCmd --
  122.  *
  123.  *    This procedure is invoked to process the "postscript" options
  124.  *    of the widget command for canvas widgets. See the user
  125.  *    documentation for details on what it does.
  126.  *
  127.  * Results:
  128.  *    A standard Tcl result.
  129.  *
  130.  * Side effects:
  131.  *    See the user documentation.
  132.  *
  133.  *--------------------------------------------------------------
  134.  */
  135.  
  136.     /* ARGSUSED */
  137. int
  138. TkCanvPostscriptCmd(canvasPtr, interp, argc, argv)
  139.     TkCanvas *canvasPtr;        /* Information about canvas widget. */
  140.     Tcl_Interp *interp;            /* Current interpreter. */
  141.     int argc;                /* Number of arguments. */
  142.     char **argv;            /* Argument strings.  Caller has
  143.                      * already parsed this command enough
  144.                      * to know that argv[1] is
  145.                      * "postscript". */
  146. {
  147.     TkPostscriptInfo psInfo, *oldInfoPtr;
  148.     int result = TCL_ERROR;
  149.     Tk_Item *itemPtr;
  150. #define STRING_LENGTH 400
  151.     char string[STRING_LENGTH+1], *p;
  152.     time_t now;
  153. #if !(defined(__WIN32__) || defined(MAC_TCL))
  154.     struct passwd *pwPtr;
  155. #endif /* __WIN32__ || MAC_TCL */
  156.     FILE *f;
  157.     size_t length;
  158.     int deltaX = 0, deltaY = 0;        /* Offset of lower-left corner of
  159.                      * area to be marked up, measured
  160.                      * in canvas units from the positioning
  161.                      * point on the page (reflects
  162.                      * anchor position).  Initial values
  163.                      * needed only to stop compiler
  164.                      * warnings. */
  165.     Tcl_HashSearch search;
  166.     Tcl_HashEntry *hPtr;
  167.     Tcl_DString buffer;
  168.     char *libDir;
  169.  
  170.     /*
  171.      *----------------------------------------------------------------
  172.      * Initialize the data structure describing Postscript generation,
  173.      * then process all the arguments to fill the data structure in.
  174.      *----------------------------------------------------------------
  175.      */
  176.  
  177.     oldInfoPtr = canvasPtr->psInfoPtr;
  178.     canvasPtr->psInfoPtr = &psInfo;
  179.     psInfo.x = canvasPtr->xOrigin;
  180.     psInfo.y = canvasPtr->yOrigin;
  181.     psInfo.width = -1;
  182.     psInfo.height = -1;
  183.     psInfo.pageXString = NULL;
  184.     psInfo.pageYString = NULL;
  185.     psInfo.pageX = 72*4.25;
  186.     psInfo.pageY = 72*5.5;
  187.     psInfo.pageWidthString = NULL;
  188.     psInfo.pageHeightString = NULL;
  189.     psInfo.scale = 1.0;
  190.     psInfo.pageAnchor = TK_ANCHOR_CENTER;
  191.     psInfo.rotate = 0;
  192.     psInfo.fontVar = NULL;
  193.     psInfo.colorVar = NULL;
  194.     psInfo.colorMode = NULL;
  195.     psInfo.colorLevel = 0;
  196.     psInfo.fileName = NULL;
  197.     psInfo.f = NULL;
  198.     psInfo.prepass = 0;
  199.     Tcl_InitHashTable(&psInfo.fontTable, TCL_STRING_KEYS);
  200.     result = Tk_ConfigureWidget(canvasPtr->interp, canvasPtr->tkwin,
  201.         configSpecs, argc-2, argv+2, (char *) &psInfo,
  202.         TK_CONFIG_ARGV_ONLY);
  203.     if (result != TCL_OK) {
  204.     goto cleanup;
  205.     }
  206.  
  207.     if (psInfo.width == -1) {
  208.     psInfo.width = Tk_Width(canvasPtr->tkwin);
  209.     }
  210.     if (psInfo.height == -1) {
  211.     psInfo.height = Tk_Height(canvasPtr->tkwin);
  212.     }
  213.     psInfo.x2 = psInfo.x + psInfo.width;
  214.     psInfo.y2 = psInfo.y + psInfo.height;
  215.  
  216.     if (psInfo.pageXString != NULL) {
  217.     if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageXString,
  218.         &psInfo.pageX) != TCL_OK) {
  219.         goto cleanup;
  220.     }
  221.     }
  222.     if (psInfo.pageYString != NULL) {
  223.     if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageYString,
  224.         &psInfo.pageY) != TCL_OK) {
  225.         goto cleanup;
  226.     }
  227.     }
  228.     if (psInfo.pageWidthString != NULL) {
  229.     if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageWidthString,
  230.         &psInfo.scale) != TCL_OK) {
  231.         goto cleanup;
  232.     }
  233.     psInfo.scale /= psInfo.width;
  234.     } else if (psInfo.pageHeightString != NULL) {
  235.     if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageHeightString,
  236.         &psInfo.scale) != TCL_OK) {
  237.         goto cleanup;
  238.     }
  239.     psInfo.scale /= psInfo.height;
  240.     } else {
  241.     psInfo.scale = (72.0/25.4)*WidthMMOfScreen(Tk_Screen(canvasPtr->tkwin));
  242.     psInfo.scale /= WidthOfScreen(Tk_Screen(canvasPtr->tkwin));
  243.     }
  244.     switch (psInfo.pageAnchor) {
  245.     case TK_ANCHOR_NW:
  246.     case TK_ANCHOR_W:
  247.     case TK_ANCHOR_SW:
  248.         deltaX = 0;
  249.         break;
  250.     case TK_ANCHOR_N:
  251.     case TK_ANCHOR_CENTER:
  252.     case TK_ANCHOR_S:
  253.         deltaX = -psInfo.width/2;
  254.         break;
  255.     case TK_ANCHOR_NE:
  256.     case TK_ANCHOR_E:
  257.     case TK_ANCHOR_SE:
  258.         deltaX = -psInfo.width;
  259.         break;
  260.     }
  261.     switch (psInfo.pageAnchor) {
  262.     case TK_ANCHOR_NW:
  263.     case TK_ANCHOR_N:
  264.     case TK_ANCHOR_NE:
  265.         deltaY = - psInfo.height;
  266.         break;
  267.     case TK_ANCHOR_W:
  268.     case TK_ANCHOR_CENTER:
  269.     case TK_ANCHOR_E:
  270.         deltaY = -psInfo.height/2;
  271.         break;
  272.     case TK_ANCHOR_SW:
  273.     case TK_ANCHOR_S:
  274.     case TK_ANCHOR_SE:
  275.         deltaY = 0;
  276.         break;
  277.     }
  278.  
  279.     if (psInfo.colorMode == NULL) {
  280.     psInfo.colorLevel = 2;
  281.     } else {
  282.     length = strlen(psInfo.colorMode);
  283.     if (strncmp(psInfo.colorMode, "monochrome", length) == 0) {
  284.         psInfo.colorLevel = 0;
  285.     } else if (strncmp(psInfo.colorMode, "gray", length) == 0) {
  286.         psInfo.colorLevel = 1;
  287.     } else if (strncmp(psInfo.colorMode, "color", length) == 0) {
  288.         psInfo.colorLevel = 2;
  289.     } else {
  290.         Tcl_AppendResult(canvasPtr->interp, "bad color mode \"",
  291.             psInfo.colorMode, "\": must be monochrome, ",
  292.             "gray, or color", (char *) NULL);
  293.         goto cleanup;
  294.     }
  295.     }
  296.  
  297.     if (psInfo.fileName != NULL) {
  298.     p = Tcl_TranslateFileName(canvasPtr->interp, psInfo.fileName, &buffer);
  299.     if (p == NULL) {
  300.         goto cleanup;
  301.     }
  302.     psInfo.f = fopen(p, "w");
  303.     Tcl_DStringFree(&buffer);
  304.     if (psInfo.f == NULL) {
  305.         Tcl_AppendResult(canvasPtr->interp, "couldn't write file \"",
  306.             psInfo.fileName, "\": ",
  307.             Tcl_PosixError(canvasPtr->interp), (char *) NULL);
  308.         goto cleanup;
  309.     }
  310.     }
  311.  
  312.     /*
  313.      *--------------------------------------------------------
  314.      * Make a pre-pass over all of the items, generating Postscript
  315.      * and then throwing it away.  The purpose of this pass is just
  316.      * to collect information about all the fonts in use, so that
  317.      * we can output font information in the proper form required
  318.      * by the Document Structuring Conventions.
  319.      *--------------------------------------------------------
  320.      */
  321.  
  322.     psInfo.prepass = 1;
  323.     for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
  324.         itemPtr = itemPtr->nextPtr) {
  325.     if ((itemPtr->x1 >= psInfo.x2) || (itemPtr->x2 < psInfo.x)
  326.         || (itemPtr->y1 >= psInfo.y2) || (itemPtr->y2 < psInfo.y)) {
  327.         continue;
  328.     }
  329.     if (itemPtr->typePtr->postscriptProc == NULL) {
  330.         continue;
  331.     }
  332.     result = (*itemPtr->typePtr->postscriptProc)(canvasPtr->interp,
  333.         (Tk_Canvas) canvasPtr, itemPtr, 1);
  334.     Tcl_ResetResult(canvasPtr->interp);
  335.     if (result != TCL_OK) {
  336.         /*
  337.          * An error just occurred.  Just skip out of this loop.
  338.          * There's no need to report the error now;  it can be
  339.          * reported later (errors can happen later that don't
  340.          * happen now, so we still have to check for errors later
  341.          * anyway).
  342.          */
  343.         break;
  344.     }
  345.     }
  346.     psInfo.prepass = 0;
  347.  
  348.     /*
  349.      *--------------------------------------------------------
  350.      * Generate the header and prolog for the Postscript.
  351.      *--------------------------------------------------------
  352.      */
  353.  
  354.     Tcl_AppendResult(canvasPtr->interp, "%!PS-Adobe-3.0 EPSF-3.0\n",
  355.         "%%Creator: Tk Canvas Widget\n", (char *) NULL);
  356. #if !(defined(__WIN32__) || defined(MAC_TCL))
  357.     pwPtr = getpwuid(getuid());
  358.     Tcl_AppendResult(canvasPtr->interp, "%%For: ",
  359.         (pwPtr != NULL) ? pwPtr->pw_gecos : "Unknown", "\n",
  360.         (char *) NULL);
  361.     endpwent();
  362. #endif /* __WIN32__ || MAC_TCL */
  363.     Tcl_AppendResult(canvasPtr->interp, "%%Title: Window ",
  364.         Tk_PathName(canvasPtr->tkwin), "\n", (char *) NULL);
  365.     time(&now);
  366.     Tcl_AppendResult(canvasPtr->interp, "%%CreationDate: ",
  367.         ctime(&now), (char *) NULL);
  368.     if (!psInfo.rotate) {
  369.     sprintf(string, "%d %d %d %d",
  370.         (int) (psInfo.pageX + psInfo.scale*deltaX),
  371.         (int) (psInfo.pageY + psInfo.scale*deltaY),
  372.         (int) (psInfo.pageX + psInfo.scale*(deltaX + psInfo.width)
  373.             + 1.0),
  374.         (int) (psInfo.pageY + psInfo.scale*(deltaY + psInfo.height)
  375.             + 1.0));
  376.     } else {
  377.     sprintf(string, "%d %d %d %d",
  378.         (int) (psInfo.pageX - psInfo.scale*(deltaY + psInfo.height)),
  379.         (int) (psInfo.pageY + psInfo.scale*deltaX),
  380.         (int) (psInfo.pageX - psInfo.scale*deltaY + 1.0),
  381.         (int) (psInfo.pageY + psInfo.scale*(deltaX + psInfo.width)
  382.             + 1.0));
  383.     }
  384.     Tcl_AppendResult(canvasPtr->interp, "%%BoundingBox: ", string,
  385.         "\n", (char *) NULL);
  386.     Tcl_AppendResult(canvasPtr->interp, "%%Pages: 1\n", 
  387.         "%%DocumentData: Clean7Bit\n", (char *) NULL);
  388.     Tcl_AppendResult(canvasPtr->interp, "%%Orientation: ",
  389.         psInfo.rotate ? "Landscape\n" : "Portrait\n", (char *) NULL);
  390.     p = "%%DocumentNeededResources: font ";
  391.     for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search);
  392.         hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
  393.     Tcl_AppendResult(canvasPtr->interp, p,
  394.         Tcl_GetHashKey(&psInfo.fontTable, hPtr),
  395.         "\n", (char *) NULL);
  396.     p = "%%+ font ";
  397.     }
  398.     Tcl_AppendResult(canvasPtr->interp, "%%EndComments\n\n", (char *) NULL);
  399.  
  400.     /*
  401.      * Read a standard prolog file from disk and insert it into
  402.      * the Postscript.
  403.      */
  404.  
  405. #ifdef STk_CODE
  406.     libDir = Tcl_GetVar(canvasPtr->interp, "*stk-library*", TCL_GLOBAL_ONLY);
  407. #else
  408.     libDir = Tcl_GetVar(canvasPtr->interp, "tk_library", TCL_GLOBAL_ONLY);
  409. #endif
  410.     if (libDir == NULL) {
  411.     Tcl_ResetResult(canvasPtr->interp);
  412.     Tcl_AppendResult(canvasPtr->interp, "couldn't find library directory: ",
  413. #ifdef STk_CODE
  414.         "*stk-library* variable doesn't exist", (char *) NULL);
  415. #else
  416.         "tk_library variable doesn't exist", (char *) NULL);
  417. #endif
  418.     goto cleanup;
  419.     }
  420. #ifdef STk_CODE
  421.     sprintf(string, "%.350s/STk/prolog.ps", libDir);
  422. #else
  423.     sprintf(string, "%.350s/prolog.ps", libDir);
  424. #endif
  425.     p = Tcl_TranslateFileName(canvasPtr->interp, string, &buffer);
  426.     f = fopen(p, "r");
  427.     Tcl_DStringFree(&buffer);
  428.     if (f == NULL) {
  429.     Tcl_ResetResult(canvasPtr->interp);
  430.     Tcl_AppendResult(canvasPtr->interp, "couldn't open prolog file \"",
  431.         string, "\": ", Tcl_PosixError(canvasPtr->interp),
  432.         (char *) NULL);
  433.     goto cleanup;
  434.     }
  435.     while (fgets(string, STRING_LENGTH, f) != NULL) {
  436.     Tcl_AppendResult(canvasPtr->interp, string, (char *) NULL);
  437.     }
  438.     if (ferror(f)) {
  439.     fclose(f);
  440.     Tcl_ResetResult(canvasPtr->interp);
  441.     Tcl_AppendResult(canvasPtr->interp, "error reading prolog file \"",
  442.         string, "\": ",
  443.         Tcl_PosixError(canvasPtr->interp), (char *) NULL);
  444.     goto cleanup;
  445.     }
  446.     fclose(f);
  447.     if (psInfo.f != NULL) {
  448.     fputs(canvasPtr->interp->result, psInfo.f);
  449.     Tcl_ResetResult(canvasPtr->interp);
  450.     }
  451.  
  452.     /*
  453.      *-----------------------------------------------------------
  454.      * Document setup:  set the color level and include fonts.
  455.      *-----------------------------------------------------------
  456.      */
  457.  
  458.     sprintf(string, "/CL %d def\n", psInfo.colorLevel);
  459.     Tcl_AppendResult(canvasPtr->interp, "%%BeginSetup\n", string,
  460.         (char *) NULL);
  461.     for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search);
  462.         hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
  463.     Tcl_AppendResult(canvasPtr->interp, "%%IncludeResource: font ",
  464.         Tcl_GetHashKey(&psInfo.fontTable, hPtr), "\n", (char *) NULL);
  465.     }
  466.     Tcl_AppendResult(canvasPtr->interp, "%%EndSetup\n\n", (char *) NULL);
  467.  
  468.     /*
  469.      *-----------------------------------------------------------
  470.      * Page setup:  move to page positioning point, rotate if
  471.      * needed, set scale factor, offset for proper anchor position,
  472.      * and set clip region.
  473.      *-----------------------------------------------------------
  474.      */
  475.  
  476.     Tcl_AppendResult(canvasPtr->interp, "%%Page: 1 1\n", "save\n",
  477.         (char *) NULL);
  478.     sprintf(string, "%.1f %.1f translate\n", psInfo.pageX, psInfo.pageY);
  479.     Tcl_AppendResult(canvasPtr->interp, string, (char *) NULL);
  480.     if (psInfo.rotate) {
  481.     Tcl_AppendResult(canvasPtr->interp, "90 rotate\n", (char *) NULL);
  482.     }
  483.     sprintf(string, "%.4g %.4g scale\n", psInfo.scale, psInfo.scale);
  484.     Tcl_AppendResult(canvasPtr->interp, string, (char *) NULL);
  485.     sprintf(string, "%d %d translate\n", deltaX - psInfo.x, deltaY);
  486.     Tcl_AppendResult(canvasPtr->interp, string, (char *) NULL);
  487.     sprintf(string, "%d %.15g moveto %d %.15g lineto %d %.15g lineto %d %.15g",
  488.         psInfo.x, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y),
  489.         psInfo.x2, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y),
  490.         psInfo.x2, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y2),
  491.         psInfo.x, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y2));
  492.     Tcl_AppendResult(canvasPtr->interp, string,
  493.     " lineto closepath clip newpath\n", (char *) NULL);
  494.     if (psInfo.f != NULL) {
  495.     fputs(canvasPtr->interp->result, psInfo.f);
  496.     Tcl_ResetResult(canvasPtr->interp);
  497.     }
  498.  
  499.     /*
  500.      *---------------------------------------------------------------------
  501.      * Iterate through all the items, having each relevant one draw itself.
  502.      * Quit if any of the items returns an error.
  503.      *---------------------------------------------------------------------
  504.      */
  505.  
  506.     result = TCL_OK;
  507.     for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
  508.         itemPtr = itemPtr->nextPtr) {
  509.     if ((itemPtr->x1 >= psInfo.x2) || (itemPtr->x2 < psInfo.x)
  510.         || (itemPtr->y1 >= psInfo.y2) || (itemPtr->y2 < psInfo.y)) {
  511.         continue;
  512.     }
  513.     if (itemPtr->typePtr->postscriptProc == NULL) {
  514.         continue;
  515.     }
  516.     Tcl_AppendResult(canvasPtr->interp, "gsave\n", (char *) NULL);
  517.     result = (*itemPtr->typePtr->postscriptProc)(canvasPtr->interp,
  518.         (Tk_Canvas) canvasPtr, itemPtr, 0);
  519.     if (result != TCL_OK) {
  520.         char msg[100];
  521.  
  522.         sprintf(msg, "\n    (generating Postscript for item %d)",
  523.             itemPtr->id);
  524.         Tcl_AddErrorInfo(canvasPtr->interp, msg);
  525.         goto cleanup;
  526.     }
  527.     Tcl_AppendResult(canvasPtr->interp, "grestore\n", (char *) NULL);
  528.     if (psInfo.f != NULL) {
  529.         fputs(canvasPtr->interp->result, psInfo.f);
  530.         Tcl_ResetResult(canvasPtr->interp);
  531.     }
  532.     }
  533.  
  534.     /*
  535.      *---------------------------------------------------------------------
  536.      * Output page-end information, such as commands to print the page
  537.      * and document trailer stuff.
  538.      *---------------------------------------------------------------------
  539.      */
  540.  
  541.     Tcl_AppendResult(canvasPtr->interp, "restore showpage\n\n",
  542.         "%%Trailer\nend\n%%EOF\n", (char *) NULL);
  543.     if (psInfo.f != NULL) {
  544.     fputs(canvasPtr->interp->result, psInfo.f);
  545.     Tcl_ResetResult(canvasPtr->interp);
  546.     }
  547.  
  548.     /*
  549.      * Clean up psInfo to release malloc'ed stuff.
  550.      */
  551.  
  552.     cleanup:
  553.     if (psInfo.pageXString != NULL) {
  554.     ckfree(psInfo.pageXString);
  555.     }
  556.     if (psInfo.pageYString != NULL) {
  557.     ckfree(psInfo.pageYString);
  558.     }
  559.     if (psInfo.pageWidthString != NULL) {
  560.     ckfree(psInfo.pageWidthString);
  561.     }
  562.     if (psInfo.pageHeightString != NULL) {
  563.     ckfree(psInfo.pageHeightString);
  564.     }
  565.     if (psInfo.fontVar != NULL) {
  566.     ckfree(psInfo.fontVar);
  567.     }
  568.     if (psInfo.colorVar != NULL) {
  569.     ckfree(psInfo.colorVar);
  570.     }
  571.     if (psInfo.colorMode != NULL) {
  572.     ckfree(psInfo.colorMode);
  573.     }
  574.     if (psInfo.fileName != NULL) {
  575.     ckfree(psInfo.fileName);
  576.     }
  577.     if (psInfo.f != NULL) {
  578.     fclose(psInfo.f);
  579.     }
  580.     Tcl_DeleteHashTable(&psInfo.fontTable);
  581.     canvasPtr->psInfoPtr = oldInfoPtr;
  582.     return result;
  583. }
  584.  
  585. /*
  586.  *--------------------------------------------------------------
  587.  *
  588.  * Tk_CanvasPsColor --
  589.  *
  590.  *    This procedure is called by individual canvas items when
  591.  *    they want to set a color value for output.  Given information
  592.  *    about an X color, this procedure will generate Postscript
  593.  *    commands to set up an appropriate color in Postscript.
  594.  *
  595.  * Results:
  596.  *    Returns a standard Tcl return value.  If an error occurs
  597.  *    then an error message will be left in interp->result.
  598.  *    If no error occurs, then additional Postscript will be
  599.  *    appended to interp->result.
  600.  *
  601.  * Side effects:
  602.  *    None.
  603.  *
  604.  *--------------------------------------------------------------
  605.  */
  606.  
  607. int
  608. Tk_CanvasPsColor(interp, canvas, colorPtr)
  609.     Tcl_Interp *interp;            /* Interpreter for returning Postscript
  610.                      * or error message. */
  611.     Tk_Canvas canvas;            /* Information about canvas. */
  612.     XColor *colorPtr;            /* Information about color. */
  613. {
  614.     TkCanvas *canvasPtr = (TkCanvas *) canvas;
  615.     TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr;
  616.     int tmp;
  617.     double red, green, blue;
  618.     char string[200];
  619.  
  620.     if (psInfoPtr->prepass) {
  621.     return TCL_OK;
  622.     }
  623.  
  624.     /*
  625.      * If there is a color map defined, then look up the color's name
  626.      * in the map and use the Postscript commands found there, if there
  627.      * are any.
  628.      */
  629.  
  630.     if (psInfoPtr->colorVar != NULL) {
  631.     char *cmdString;
  632.  
  633.     cmdString = Tcl_GetVar2(interp, psInfoPtr->colorVar,
  634.         Tk_NameOfColor(colorPtr), 0);
  635.     if (cmdString != NULL) {
  636.         Tcl_AppendResult(interp, cmdString, "\n", (char *) NULL);
  637.         return TCL_OK;
  638.     }
  639.     }
  640.  
  641.     /*
  642.      * No color map entry for this color.  Grab the color's intensities
  643.      * and output Postscript commands for them.  Special note:  X uses
  644.      * a range of 0-65535 for intensities, but most displays only use
  645.      * a range of 0-255, which maps to (0, 256, 512, ... 65280) in the
  646.      * X scale.  This means that there's no way to get perfect white,
  647.      * since the highest intensity is only 65280 out of 65535.  To
  648.      * work around this problem, rescale the X intensity to a 0-255
  649.      * scale and use that as the basis for the Postscript colors.  This
  650.      * scheme still won't work if the display only uses 4 bits per color,
  651.      * but most diplays use at least 8 bits.
  652.      */
  653.  
  654.     tmp = colorPtr->red;
  655.     red = ((double) (tmp >> 8))/255.0;
  656.     tmp = colorPtr->green;
  657.     green = ((double) (tmp >> 8))/255.0;
  658.     tmp = colorPtr->blue;
  659.     blue = ((double) (tmp >> 8))/255.0;
  660.     sprintf(string, "%.3f %.3f %.3f setrgbcolor AdjustColor\n",
  661.         red, green, blue);
  662.     Tcl_AppendResult(interp, string, (char *) NULL);
  663.     return TCL_OK;
  664. }
  665.  
  666. /*
  667.  *--------------------------------------------------------------
  668.  *
  669.  * Tk_CanvasPsFont --
  670.  *
  671.  *    This procedure is called by individual canvas items when
  672.  *    they want to output text.  Given information about an X
  673.  *    font, this procedure will generate Postscript commands
  674.  *    to set up an appropriate font in Postscript.
  675.  *
  676.  * Results:
  677.  *    Returns a standard Tcl return value.  If an error occurs
  678.  *    then an error message will be left in interp->result.
  679.  *    If no error occurs, then additional Postscript will be
  680.  *    appended to the interp->result.
  681.  *
  682.  * Side effects:
  683.  *    The Postscript font name is entered into psInfoPtr->fontTable
  684.  *    if it wasn't already there.
  685.  *
  686.  *--------------------------------------------------------------
  687.  */
  688.  
  689. int
  690. Tk_CanvasPsFont(interp, canvas, fontStructPtr)
  691.     Tcl_Interp *interp;            /* Interpreter for returning Postscript
  692.                      * or error message. */
  693.     Tk_Canvas canvas;            /* Information about canvas. */
  694.     XFontStruct *fontStructPtr;        /* Information about font in which text
  695.                      * is to be printed. */
  696. {
  697.     TkCanvas *canvasPtr = (TkCanvas *) canvas;
  698.     TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr;
  699.     char *name, *end, *weightString, *slantString;
  700. #define TOTAL_FIELDS    8
  701. #define FAMILY_FIELD    1
  702. #define WEIGHT_FIELD    2
  703. #define SLANT_FIELD    3
  704. #define SIZE_FIELD    7
  705.     char *fieldPtrs[TOTAL_FIELDS];
  706. #define MAX_NAME_SIZE 100
  707.     char fontName[MAX_NAME_SIZE+50], pointString[20];
  708.     int i, c, weightSize, nameSize, points;
  709.     char *p;
  710.  
  711.     name = Tk_NameOfFontStruct(fontStructPtr);
  712.  
  713.     /*
  714.      * First, look up the font's name in the font map, if there is one.
  715.      * If there is an entry for this font, it consists of a list
  716.      * containing font name and size.  Use this information.
  717.      */
  718.  
  719.     if (psInfoPtr->fontVar != NULL) {
  720.     char *list, **argv;
  721.     int argc;
  722.     double size;
  723.  
  724.     list = Tcl_GetVar2(interp, psInfoPtr->fontVar,
  725.         name, 0);
  726.     if (list != NULL) {
  727.         if (Tcl_SplitList(interp, list, &argc, &argv) != TCL_OK) {
  728.         badMapEntry:
  729.         Tcl_ResetResult(interp);
  730.         Tcl_AppendResult(interp, "bad font map entry for \"", name,
  731.             "\": \"", list, "\"", (char *) NULL);
  732.         return TCL_ERROR;
  733.         }
  734.         if (argc != 2) {
  735.         goto badMapEntry;
  736.         }
  737.         size = strtod(argv[1], &end);
  738.         if ((size <= 0) || (*end != 0)) {
  739.         goto badMapEntry;
  740.         }
  741.         sprintf(pointString, "%.15g", size);
  742.         Tcl_AppendResult(interp, "/", argv[0], " findfont ",
  743.             pointString, " scalefont ", (char *) NULL);
  744.         if (strncasecmp(argv[0], "Symbol", 7) != 0) {
  745.         Tcl_AppendResult(interp, "ISOEncode ", (char *) NULL);
  746.         }
  747.         Tcl_AppendResult(interp, "setfont\n", (char *) NULL);
  748.         Tcl_CreateHashEntry(&psInfoPtr->fontTable, argv[0], &i);
  749.         ckfree((char *) argv);
  750.         return TCL_OK;
  751.     }
  752.     }
  753.  
  754.     /*
  755.      * Not in the font map.  Try to parse the name to get four fields:
  756.      * family name, weight, slant, and point size.  To do this, split the
  757.      * font name up into fields, storing pointers to the first character
  758.      * of each field in fieldPtrs.
  759.      */
  760.  
  761.     if (name[0] != '-') {
  762.     goto error;
  763.     }
  764.     for (p =  name+1, i = 0; i < TOTAL_FIELDS; i++) {
  765.     fieldPtrs[i] = p;
  766.     while (*p != '-') {
  767.         if (*p == 0) {
  768.         goto error;
  769.         }
  770.         p++;
  771.     }
  772.     p++;
  773.     }
  774.  
  775.     /*
  776.      * Use the information from the X font name to make a guess at a
  777.      * Postscript font name of the form "<family>-<weight><slant>" where
  778.      * <weight> and <slant> may be omitted and if both are omitted then
  779.      * the dash is also omitted.  Postscript is very picky about font names,
  780.      * so there are several heuristics in the code below (e.g. don't
  781.      * include a "Roman" slant except for "Times" font, and make sure
  782.      * that the first letter of each field is capitalized but no other
  783.      * letters are in caps).
  784.      */
  785.  
  786.     nameSize = fieldPtrs[FAMILY_FIELD+1] - 1 - fieldPtrs[FAMILY_FIELD];
  787.     if ((nameSize == 0) || (nameSize > MAX_NAME_SIZE)) {
  788.     goto error;
  789.     }
  790.     strncpy(fontName, fieldPtrs[FAMILY_FIELD], (size_t) nameSize);
  791.     if (islower(UCHAR(fontName[0]))) {
  792.     fontName[0] = toupper(UCHAR(fontName[0]));
  793.     }
  794.     for (p = fontName+1, i = nameSize-1; i > 0; p++, i--) {
  795.     if (isupper(UCHAR(*p))) {
  796.         *p = tolower(UCHAR(*p));
  797.     }
  798.     }
  799.     *p = 0;
  800.     weightSize = fieldPtrs[WEIGHT_FIELD+1] - 1 - fieldPtrs[WEIGHT_FIELD];
  801.     if (weightSize == 0) {
  802.     goto error;
  803.     }
  804.     if (strncasecmp(fieldPtrs[WEIGHT_FIELD], "medium",
  805.         (size_t) weightSize) == 0) {
  806.     weightString = "";
  807.     } else if (strncasecmp(fieldPtrs[WEIGHT_FIELD], "bold",
  808.         (size_t) weightSize) == 0) {
  809.     weightString = "Bold";
  810.     } else {
  811.     goto error;
  812.     }
  813.     if (fieldPtrs[SLANT_FIELD+1] != (fieldPtrs[SLANT_FIELD] + 2)) {
  814.     goto error;
  815.     }
  816.     c = fieldPtrs[SLANT_FIELD][0];
  817.     if ((c == 'r') || (c == 'R')) {
  818.     slantString = "";
  819.     if ((weightString[0] == 0) && (nameSize == 5)
  820.         && (strncmp(fontName, "Times", 5) == 0)) {
  821.         slantString = "Roman";
  822.     }
  823.     } else if ((c == 'i') || (c == 'I')) {
  824.     slantString = "Italic";
  825.     } else if ((c == 'o') || (c == 'O')) {
  826.     slantString = "Oblique";
  827.     } else {
  828.     goto error;
  829.     }
  830.     if ((weightString[0] != 0) || (slantString[0] != 0)) {
  831.     sprintf(p, "-%s%s", weightString, slantString);
  832.     }
  833.     points = strtoul(fieldPtrs[SIZE_FIELD], &end, 0);
  834.     if (points == 0) {
  835.     goto error;
  836.     }
  837.     sprintf(pointString, "%.15g", ((double) points)/10.0);
  838.     Tcl_AppendResult(interp, "/", fontName, " findfont ",
  839.         pointString, " scalefont ", (char *) NULL);
  840.     if (strcmp(fontName, "Symbol") != 0) {
  841.     Tcl_AppendResult(interp, "ISOEncode ", (char *) NULL);
  842.     }
  843.     Tcl_AppendResult(interp, "setfont\n", (char *) NULL);
  844.     Tcl_CreateHashEntry(&psInfoPtr->fontTable, fontName, &i);
  845.     return TCL_OK;
  846.  
  847.     error:
  848.     Tcl_ResetResult(interp);
  849.     Tcl_AppendResult(interp, "couldn't translate font name \"",
  850.         name, "\" to Postscript", (char *) NULL);
  851.     return TCL_ERROR;
  852. }
  853.  
  854. /*
  855.  *--------------------------------------------------------------
  856.  *
  857.  * Tk_CanvasPsBitmap --
  858.  *
  859.  *    This procedure is called to output the contents of a
  860.  *    sub-region of a bitmap in proper image data format for
  861.  *    Postscript (i.e. data between angle brackets, one bit
  862.  *    per pixel).
  863.  *
  864.  * Results:
  865.  *    Returns a standard Tcl return value.  If an error occurs
  866.  *    then an error message will be left in interp->result.
  867.  *    If no error occurs, then additional Postscript will be
  868.  *    appended to interp->result.
  869.  *
  870.  * Side effects:
  871.  *    None.
  872.  *
  873.  *--------------------------------------------------------------
  874.  */
  875.  
  876. int
  877. Tk_CanvasPsBitmap(interp, canvas, bitmap, startX, startY, width, height)
  878.     Tcl_Interp *interp;            /* Interpreter for returning Postscript
  879.                      * or error message. */
  880.     Tk_Canvas canvas;            /* Information about canvas. */
  881.     Pixmap bitmap;            /* Bitmap for which to generate
  882.                      * Postscript. */
  883.     int startX, startY;            /* Coordinates of upper-left corner
  884.                      * of rectangular region to output. */
  885.     int width, height;            /* Height of rectangular region. */
  886. {
  887.     TkCanvas *canvasPtr = (TkCanvas *) canvas;
  888.     TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr;
  889.     XImage *imagePtr;
  890.     int charsInLine, x, y, lastX, lastY, value, mask;
  891.     unsigned int totalWidth, totalHeight;
  892.     char string[100];
  893.     Window dummyRoot;
  894.     int dummyX, dummyY;
  895.     unsigned dummyBorderwidth, dummyDepth;
  896.  
  897.     if (psInfoPtr->prepass) {
  898.     return TCL_OK;
  899.     }
  900.  
  901.     /*
  902.      * The following call should probably be a call to Tk_SizeOfBitmap
  903.      * instead, but it seems that we are occasionally invoked by custom
  904.      * item types that create their own bitmaps without registering them
  905.      * with Tk.  XGetGeometry is a bit slower than Tk_SizeOfBitmap, but
  906.      * it shouldn't matter here.
  907.      */
  908.  
  909.     XGetGeometry(Tk_Display(Tk_CanvasTkwin(canvas)), bitmap, &dummyRoot,
  910.         (int *) &dummyX, (int *) &dummyY, (unsigned int *) &totalWidth,
  911.         (unsigned int *) &totalHeight, &dummyBorderwidth, &dummyDepth);
  912.     imagePtr = XGetImage(Tk_Display(canvasPtr->tkwin), bitmap, 0, 0,
  913.         totalWidth, totalHeight, 1, XYPixmap);
  914.     Tcl_AppendResult(interp, "<", (char *) NULL);
  915.     mask = 0x80;
  916.     value = 0;
  917.     charsInLine = 0;
  918.     lastX = startX + width - 1;
  919.     lastY = startY + height - 1;
  920.     for (y = lastY; y >= startY; y--) {
  921.     for (x = startX; x <= lastX; x++) {
  922.         if (XGetPixel(imagePtr, x, y)) {
  923.         value |= mask;
  924.         }
  925.         mask >>= 1;
  926.         if (mask == 0) {
  927.         sprintf(string, "%02x", value);
  928.         Tcl_AppendResult(interp, string, (char *) NULL);
  929.         mask = 0x80;
  930.         value = 0;
  931.         charsInLine += 2;
  932.         if (charsInLine >= 60) {
  933.             Tcl_AppendResult(interp, "\n", (char *) NULL);
  934.             charsInLine = 0;
  935.         }
  936.         }
  937.     }
  938.     if (mask != 0x80) {
  939.         sprintf(string, "%02x", value);
  940.         Tcl_AppendResult(interp, string, (char *) NULL);
  941.         mask = 0x80;
  942.         value = 0;
  943.         charsInLine += 2;
  944.     }
  945.     }
  946.     Tcl_AppendResult(interp, ">", (char *) NULL);
  947.     XDestroyImage(imagePtr);
  948.     return TCL_OK;
  949. }
  950.  
  951. /*
  952.  *--------------------------------------------------------------
  953.  *
  954.  * Tk_CanvasPsStipple --
  955.  *
  956.  *    This procedure is called by individual canvas items when
  957.  *    they have created a path that they'd like to be filled with
  958.  *    a stipple pattern.  Given information about an X bitmap,
  959.  *    this procedure will generate Postscript commands to fill
  960.  *    the current clip region using a stipple pattern defined by the
  961.  *    bitmap.
  962.  *
  963.  * Results:
  964.  *    Returns a standard Tcl return value.  If an error occurs
  965.  *    then an error message will be left in interp->result.
  966.  *    If no error occurs, then additional Postscript will be
  967.  *    appended to interp->result.
  968.  *
  969.  * Side effects:
  970.  *    None.
  971.  *
  972.  *--------------------------------------------------------------
  973.  */
  974.  
  975. int
  976. Tk_CanvasPsStipple(interp, canvas, bitmap)
  977.     Tcl_Interp *interp;            /* Interpreter for returning Postscript
  978.                      * or error message. */
  979.     Tk_Canvas canvas;            /* Information about canvas. */
  980.     Pixmap bitmap;            /* Bitmap to use for stippling. */
  981. {
  982.     TkCanvas *canvasPtr = (TkCanvas *) canvas;
  983.     TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr;
  984.     int width, height;
  985.     char string[100];
  986.     Window dummyRoot;
  987.     int dummyX, dummyY;
  988.     unsigned dummyBorderwidth, dummyDepth;
  989.  
  990.     if (psInfoPtr->prepass) {
  991.     return TCL_OK;
  992.     }
  993.  
  994.     /*
  995.      * The following call should probably be a call to Tk_SizeOfBitmap
  996.      * instead, but it seems that we are occasionally invoked by custom
  997.      * item types that create their own bitmaps without registering them
  998.      * with Tk.  XGetGeometry is a bit slower than Tk_SizeOfBitmap, but
  999.      * it shouldn't matter here.
  1000.      */
  1001.  
  1002.     XGetGeometry(Tk_Display(Tk_CanvasTkwin(canvas)), bitmap, &dummyRoot,
  1003.         (int *) &dummyX, (int *) &dummyY, (unsigned *) &width,
  1004.         (unsigned *) &height, &dummyBorderwidth, &dummyDepth);
  1005.     sprintf(string, "%d %d ", width, height);
  1006.     Tcl_AppendResult(interp, string, (char *) NULL);
  1007.     if (Tk_CanvasPsBitmap(interp, (Tk_Canvas) canvasPtr, bitmap, 0, 0,
  1008.         width, height) != TCL_OK) {
  1009.     return TCL_ERROR;
  1010.     }
  1011.     Tcl_AppendResult(interp, " StippleFill\n", (char *) NULL);
  1012.     return TCL_OK;
  1013. }
  1014.  
  1015. /*
  1016.  *--------------------------------------------------------------
  1017.  *
  1018.  * Tk_CanvasPsY --
  1019.  *
  1020.  *    Given a y-coordinate in canvas coordinates, this procedure
  1021.  *    returns a y-coordinate to use for Postscript output.
  1022.  *
  1023.  * Results:
  1024.  *    Returns the Postscript coordinate that corresponds to
  1025.  *    "y".
  1026.  *
  1027.  * Side effects:
  1028.  *    None.
  1029.  *
  1030.  *--------------------------------------------------------------
  1031.  */
  1032.  
  1033. double
  1034. Tk_CanvasPsY(canvas, y)
  1035.     Tk_Canvas canvas;            /* Token for canvas on whose behalf
  1036.                      * Postscript is being generated. */
  1037.     double y;                /* Y-coordinate in canvas coords. */
  1038. {
  1039.     TkPostscriptInfo *psInfoPtr = ((TkCanvas *) canvas)->psInfoPtr;
  1040.  
  1041.     return psInfoPtr->y2 - y;
  1042. }
  1043.  
  1044. /*
  1045.  *--------------------------------------------------------------
  1046.  *
  1047.  * Tk_CanvasPsPath --
  1048.  *
  1049.  *    Given an array of points for a path, generate Postscript
  1050.  *    commands to create the path.
  1051.  *
  1052.  * Results:
  1053.  *    Postscript commands get appended to what's in interp->result.
  1054.  *
  1055.  * Side effects:
  1056.  *    None.
  1057.  *
  1058.  *--------------------------------------------------------------
  1059.  */
  1060.  
  1061. void
  1062. Tk_CanvasPsPath(interp, canvas, coordPtr, numPoints)
  1063.     Tcl_Interp *interp;            /* Put generated Postscript in this
  1064.                      * interpreter's result field. */
  1065.     Tk_Canvas canvas;            /* Canvas on whose behalf Postscript
  1066.                      * is being generated. */
  1067.     double *coordPtr;            /* Pointer to first in array of
  1068.                      * 2*numPoints coordinates giving
  1069.                      * points for path. */
  1070.     int numPoints;            /* Number of points at *coordPtr. */
  1071. {
  1072.     TkPostscriptInfo *psInfoPtr = ((TkCanvas *) canvas)->psInfoPtr;
  1073.     char buffer[200];
  1074.  
  1075.     if (psInfoPtr->prepass) {
  1076.     return;
  1077.     }
  1078.     sprintf(buffer, "%.15g %.15g moveto\n", coordPtr[0],
  1079.         Tk_CanvasPsY(canvas, coordPtr[1]));
  1080.     Tcl_AppendResult(interp, buffer, (char *) NULL);
  1081.     for (numPoints--, coordPtr += 2; numPoints > 0;
  1082.         numPoints--, coordPtr += 2) {
  1083.     sprintf(buffer, "%.15g %.15g lineto\n", coordPtr[0],
  1084.         Tk_CanvasPsY(canvas, coordPtr[1]));
  1085.     Tcl_AppendResult(interp, buffer, (char *) NULL);
  1086.     }
  1087. }
  1088.  
  1089. /*
  1090.  *--------------------------------------------------------------
  1091.  *
  1092.  * GetPostscriptPoints --
  1093.  *
  1094.  *    Given a string, returns the number of Postscript points
  1095.  *    corresponding to that string.
  1096.  *
  1097.  * Results:
  1098.  *    The return value is a standard Tcl return result.  If
  1099.  *    TCL_OK is returned, then everything went well and the
  1100.  *    screen distance is stored at *doublePtr;  otherwise
  1101.  *    TCL_ERROR is returned and an error message is left in
  1102.  *    interp->result.
  1103.  *
  1104.  * Side effects:
  1105.  *    None.
  1106.  *
  1107.  *--------------------------------------------------------------
  1108.  */
  1109.  
  1110. static int
  1111. GetPostscriptPoints(interp, string, doublePtr)
  1112.     Tcl_Interp *interp;        /* Use this for error reporting. */
  1113.     char *string;        /* String describing a screen distance. */
  1114.     double *doublePtr;        /* Place to store converted result. */
  1115. {
  1116.     char *end;
  1117.     double d;
  1118.  
  1119.     d = strtod(string, &end);
  1120.     if (end == string) {
  1121.     error:
  1122.     Tcl_AppendResult(interp, "bad distance \"", string,
  1123.         "\"", (char *) NULL);
  1124.     return TCL_ERROR;
  1125.     }
  1126.     while ((*end != '\0') && isspace(UCHAR(*end))) {
  1127.     end++;
  1128.     }
  1129.     switch (*end) {
  1130.     case 'c':
  1131.         d *= 72.0/2.54;
  1132.         end++;
  1133.         break;
  1134.     case 'i':
  1135.         d *= 72.0;
  1136.         end++;
  1137.         break;
  1138.     case 'm':
  1139.         d *= 72.0/25.4;
  1140.         end++;
  1141.         break;
  1142.     case 0:
  1143.         break;
  1144.     case 'p':
  1145.         end++;
  1146.         break;
  1147.     default:
  1148.         goto error;
  1149.     }
  1150.     while ((*end != '\0') && isspace(UCHAR(*end))) {
  1151.     end++;
  1152.     }
  1153.     if (*end != 0) {
  1154.     goto error;
  1155.     }
  1156.     *doublePtr = d;
  1157.     return TCL_OK;
  1158. }
  1159.